home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-09-14 | 11.5 KB | 279 lines | [TEXT/CCL ] |
- ;;; Copyright 1990 by Ruben Kleiman for Apple Computer, Inc.
- ;;; Advanced Technology Group
- ;;;
- ;;; interFACE Access From Macintosh Allegro Common Lisp
- ;;; NOTICE: This code allows you to access the interFACE actors
- ;;; from within Macintosh Allegro Common Lisp. This file
- ;;; contains ONLY the interface to interFACE, but not the
- ;;; interFACE product. To purchase a copy of interFACE,
- ;;; call:
- ;;; Bright Star Technology, Inc.
- ;;; 1450 114th Ave. SE Suite 200
- ;;; Bellevue, WA 98004
- ;;; Telephone: (206) 451-3697
- ;;;
- ;;; Neither Ruben Kleiman, Apple Computer, Inc, nor
- ;;; Bright Star Technologies, Inc. are to be held
- ;;; responsible for any injury or property losses
- ;;; resulting from the use of the software provided
- ;;; in this file or for following the instructions
- ;;; provided herein. This software may not necessarily
- ;;; be upgraded with future versions of interFACE.
- ;;; No guarantees implicit or explicit are made about
- ;;; the proper functioning of this software, nor about
- ;;; the conformance of the specification provided in the
- ;;; instructions below with the actual performance of the
- ;;; software.
-
-
-
- ;;; RAVE ACCESS FOR MACINTOSH ALLEGRO COMMON LISP
- ;;; ---------------------------------------------
-
- ;;; INSTRUCTIONS:
- ;;;
- ;;; A. INSTALLATION
- ;;; 1. Buy your own copy of interFACE from Bright Star Technology, Inc.
- ;;; 2. Make sure that you put the RAVE folder immediately inside your
- ;;; Macintosh Allegro Common Lisp folder (unless you change any
- ;;; of the pathnames below).
- ;;; 3. Put the RAVE driver provided with the interFACE product inside your
- ;;; System Folder and reboot.
- ;;; 4. Put the following into the RAVE folder:
- ;;; (a) Put inside the folder named ACTORS all the actors you care to use from the
- ;;; interFACE product's "Actors I", "Actors II" and/or "Actors III"
- ;;; folders. (This folder is empty in the RAVE folder.)
- ;;; (b) The file RAVE.rsrc provided with the interFACE product.
- ;;; You can find this file inside the RAVE Pascal Bindings
- ;;; folder in the interFACE product.
- ;;; 5. The file ff.fasl is provided for your convenience. It should
- ;;; be available, however, with your version of Macintosh Allegro Common Lisp.
- ;;; This file provides you with the Lisp/Foreign Function interface.
- ;;; You should place this file in your LIBRARY folder.
- ;;; It is meant to work with Macintohs Allegro CL Version 1.3.2. (See CAVEATS, below.)
- ;;;
- ;;; B. USING IT
- ;;; 1. Evaluate this file.
- ;;; 2. TEST-RAVE is a function that shows you how to access
- ;;; the interFACE actors from Macintosh Allegro Common Lisp
- ;;; through the interface provided in this file. After evaluating
- ;;; the buffer, evaluate the expressions at the commented
- ;;; area at the end of this file.
- ;;;
- ;;; C. INTERFACE FUNCTION
- ;;; The key interface function is called SendCommand. SendCommand
- ;;; takes just one argument: a Lisp string representing the RAVE
- ;;; command that you want to send. For a complete list of RAVE
- ;;; commands, see the interFACE User's Guide which is provided with
- ;;; your interFACE product.
- ;;;
- ;;; The function TEST-RAVE, below, is probably a
- ;;; useful example of how to get an actor on a window and make it say
- ;;; something. TEST-RAVE takes two arguments: a Lisp string naming
- ;;; the actor that you want to show, and another Lisp string stating
- ;;; something that you want the actor to say.
- ;;;
- ;;; D. CAVEATS
- ;;; 1. This interface has been developed and used only on Macintosh
- ;;; Allegro Common Lisp Version 1.3.1 or greater. You can give
- ;;; it a try with earlier versions.
- ;;; 2. You can only use the {WINDOWLESS} mode when calling RAVE from
- ;;; an application. Bright Star Technology does not currently
- ;;; support any other mode for application interfaces.
- ;;; 3. The RAVE writer writes directly into your screen. The TEST-RAVE
- ;;; sample function in this file puts a window under the location
- ;;; where RAVE does the drawing, but the drawing is not actually
- ;;; directed at the window.
- ;;; 4. On occassion, a "Master Pointer..." type error has been found.
- ;;; This may be ignored.
-
- ;;; Load foreign function linker and quickdraw (should be in your LIBRARY folder in MACL):
- (require :ff)
- (require :quickdraw)
-
- ;;; Establish pathnames:
- (def-logical-pathname "RAVE" "CCL;RAVE:")
- (def-logical-pathname "ACTOR" "RAVE;ACTOR:")
- (def-logical-pathname "LIBRARIES" "RAVE;LIBRARIES:")
-
- (ff-load "RAVE;CallRAVE.p.o"
- :ffenv-name 'rave-access
- :libraries '("Libraries;Interface.o"
- "Libraries;Runtime.o"
- "Libraries;PasLib.o"))
-
- (defvar *rave-xcmd-loaded* nil)
-
- (defun parse-actor-info (string)
- (let ((s 0)
- (e (length string))
- ptr result)
- (tagbody
- cont
- (setq ptr (search "," string :start2 s :end2 e))
- (setq result (nconc result (list (subseq string s ptr))))
- (or ptr (go done))
- (setq s (1+ ptr))
- (go cont)
- done)
- (values-list result)
- ))
-
- (defun P=>C (handle &aux (size (1- (_GetHandleSize :errchk :a0 handle :d0))))
- (with-dereferenced-handles ((temp handle))
- (dotimes (i size)
- (%put-byte temp (%get-byte temp (1+ i)) i))
- (%put-byte temp #\Null size)))
-
- (defun C=>P (handle &aux (c -1) i)
- (with-dereferenced-handles ((temp handle))
- (loop
- (if (= 0 (%get-byte temp (incf c))) ;; NULL?
- (return nil)))
- (setq i (1- c))
- (loop
- (if (= i -1)
- (return nil))
- (%put-byte temp (%get-byte temp i) (1+ i))
- (decf i))
- (%put-byte temp c)))
-
- (defun load-rave-xcmd ()
- (or *rave-xcmd-loaded*
- (if (eq (setq *rave-xcmd-loaded*
- (with-pstrs ((resfile (namestring (car (directory "RAVE;RAVE.RSRC")))))
- (_openresfile :ptr resfile :word)))
- -1)
- (error "Couldn't load RAVE resource file"))))
-
- (defun load-actor-resfile (actor)
- (if (eq (with-pstrs ((resfile (namestring (car (directory (concatenate 'string "ACTOR;" actor))))))
- (_openresfile :ptr resfile :word))
- -1)
- (error "Couldn't load actor ~a's resource file" actor)))
-
- ;;; This is a baroque way of defining a foreign function.
- (LET* ((*FAST-EVAL* T))
- (EVAL '(MULTIPLE-VALUE-BIND (EntryPointer EnvPtr) (CCL::FF-LOOKUP "RAVE")
- (DEFUN RAVECOMMAND (CommandString)
- (CHECK-TYPE CommandString STRING)
- (LET* ((EntryPoint (CCL::%CDR EntryPointer))
- (GlobalReg (CCL::FFENV-A5PTR EnvPtr)))
- ;; CommandHandle DISPOSED BY RAVE DRIVER, PtrToHandle RETURNED TO RaveCommand CALLER
- (LET ((CommandHandle (_NewHandle :errchk :D0 (1+ (LENGTH CommandString)) :A0))
- (PtrToHandle (_NewPtr :errchk :D0 4 :A0)))
- (PROGN
- (_HLock :errchk :d0 CommandHandle)
- (%put-ptr PtrToHandle CommandHandle)
- (CCL::%STORE-PSTR CommandString (%get-safe-ptr CommandHandle))
- (P=>C CommandHandle)
- (let ((result (FF-CALL EntryPoint :PTR PtrToHandle :A5 GlobalReg :WORD))
- temp)
- (if (handlep (setq temp (%get-safe-ptr PtrToHandle)))
- (C=>P temp))
- (values result PtrToHandle)))))))))
-
- ;;; This is the workhorse function. Use it to send any command that you find
- ;;; in your interFACE manual to the RAVE driver.
- (defun SendCommand (string)
- (multiple-value-bind (result PtrToStringHandle)
- (RaveCommand string)
- (if (= result 0)
- (if (and (pointerp PtrToStringHandle)
- (handlep (setq result (%get-safe-ptr PtrToStringHandle))))
- (prog2 (_HLock :errchk :D0 result)
- (%get-string (%get-safe-ptr result))
- (_disposHandle :errchk :A0 result)
- (_disposPtr :errchk :A0 PtrToStringHandle))
- (error "RAVE driver error ~a" result)))))
-
-
-
-
-
- #| Testing it:
-
- ;;; EVALUATE THIS SAMPLE FUNCTION:
- (defun test-rave (actor-name &optional (sentence "Hi, there!"))
- (declare (object-variable wptr))
- (load-rave-xcmd)
- (load-actor-resfile actor-name)
- (let ((window_snap 0)
- actor_name
- actor_width
- actor_height
- actor_depth
- actor_size
- actor_window
- window_object
- (actor_origin.h 0)
- (actor_origin.v 0))
-
- (setq window_snap (SendCommand "{GET_SNAP_VALUE}")) ;;; 8-bit boundaries must be observed
-
- (if (equal window_snap "FALSE")
- (error "Get_Snap_Value command returned FALSE")
- (setq window_snap (read-from-string window_snap)))
-
- (SendCommand (format nil "{ACTOR ~a}" actor-name))
-
- (multiple-value-setq (actor_name
- actor_width
- actor_height
- actor_depth
- actor_size)
- (parse-actor-info (SendCommand "{ACTOR_INFO}")))
- (setq actor_width (read-from-string actor_width)
- actor_height (read-from-string actor_height)
- actor_depth (read-from-string actor_depth)
- actor_size (* (read-from-string actor_size) 1000))
-
- (setq actor_window (ask (setq window_object (oneof *window* :window-show nil
- :window-size (make-point actor_width
- actor_height)
- :window-type :single-edge-box
- )) wptr))
-
- (ask window_object (set-window-title actor-name))
- (ask window_object (set-window-size (make-point (+ 40 actor_width) (+ 40 actor_height))))
-
-
- (with-port actor_window
- (ask window_object (set-origin actor_origin.h actor_origin.v))
- (ask window_object (local-to-global actor_origin.h actor_origin.v))
- (setq actor_origin.h (+ 8 (truncate (* actor_origin.h window_snap) window_snap))
- actor_origin.v (+ 8 (truncate (* actor_origin.v window_snap) window_snap)))
- (ask window_object (set-window-position actor_origin.h actor_origin.v))
- (ask window_object (window-show))
- (ask window_object (window-select))
- (let ((move_actor_command (format nil "{USE ~a} {WINDOW_LAYER} {MOVE ~a,~a}"
- actor_name actor_origin.h actor_origin.v)))
-
- (SendCommand move_actor_command) ;; MOVE ACTOR ONTO WINDOW
-
- (SendCommand (format nil "{SHOW ~a}" actor_name)) ;; SHOW ACTOR
-
- (SendCommand sentence) ;; MAKE ACTOR SAY SOMETHING
-
- (SendCommand "{EXPRESS A2 10} {EXPRESS A5}") ;; MAKE ACTOR SMILE
-
- (SendCommand (format nil "{HIDE ~a}" actor_name)) ;; HIDE ACTOR
-
- (SendCommand (format nil "{RETIRE ~a}" actor_name)) ;; RETIRE ACTOR
-
- ))
-
- (ask window_object (window-close))))
-
- ;;; NOW EVALUATE THE FOLLOWING, ONE AT A TIME:
-
- (SendCommand "{WINDOWLESS}") ; STARTS THE RAVE DRIVER
-
- (SendCommand "{SPEED 170}") ; SETS THE SPEED OF SPEECH DRIVER
- (test-rave "Bill" "O K?") ; GETS A WINDOW WITH THE BILL ACTOR SAYING "OK?"
- (test-rave "Spike" "Haaigh. Yaah gott-a-smoke") ; SPIKE SPEAKS
- (test-rave "Kitty" "I tought I saw, a bird!") ; KITTY PONDERS...
-
- (SendCommand "{INTERMISSION}") ; TURNS OFF THE RAVE DRIVER
-
- |#